perm filename SUBSTV[P,JRA] blob sn#137086 filedate 1974-12-20 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(DE MATCHEM(V)
C00004 ENDMK
CāŠ—;
(DE MATCHEM(V)
 (PROG(PAIRS)
  A(COND((NULL V) (RETURN PAIRS)))
(SETQ PAIRS(CONS(CONS(CAR V)(READLIST(CONS @Y(CDR(EXPLODE(CAR V))))))
                 PAIRS))
(SETQ V(CDR V))(GO A)
))

(DE SUBST_Y_FOR_V(VARS TERMS)
 (COND((NULL TERMS)NIL)
      (T (CONS(SUBS1 VARS (CAR TERMS))(SUBST_Y_FOR_V VARS (CDR TERMS))))
)))

(DE SUBS1(VARS TERM)
(COND((ATOM TERM)(PICKIT VARS TERM))
	(T(CONS(SUBS1 VARS (CAR TERM))(SUBS1 VARS(CDR TERM))))))
)))

(DE PICKIT(VARS VAR)
 (COND((NULL VARS) VAR)
	((EQ(CAAR VARS)VAR)(CDAR VARS))
	(T(PICKIT(CDR VARS) VAR)) ))
)))

(DE SUBSYV(VARS LI)(SUBST_Y_FOR_V(MATCHEM VARS) LI) )
)))

(DE  SETUP_INASS_NAMES(VARS)
 (LIST 
(LIST @THSETQ @(THV INASS) (APPEND  @(LIST) (S_INASS VARS) @(T T)))
(LIST @THSETQ @(THV NAMES) (APPEND @(LIST) (S_NAMES VARS)@(T T)))
)))

(DE S_INASS(VARS)
(COND((NULL VARS)NIL)
     (T(CONS (LIST @THV (CAR VARS))(S_INASS (CDR VARS))))  ))
))

(DE S_NAMES(VARS)
(COND((NULL VARS)NIL)
     (T(CONS (LIST @QUOTE (CAR VARS))(S_NAMES (CDR VARS))))  ))
))